home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Microsoft Plateform / Visual Basic 5.0 / Msvb50.ace / msvb50 / MSVB50 / VB / SAMPLES / VISDATA / ADDFIELD.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-17  |  13.5 KB  |  426 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAddField 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Add Field"
  5.    ClientHeight    =   3735
  6.    ClientLeft      =   2490
  7.    ClientTop       =   2865
  8.    ClientWidth     =   6120
  9.    BeginProperty Font 
  10.       Name            =   "Tahoma"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    HelpContextID   =   2016117
  19.    Icon            =   "ADDFIELD.frx":0000
  20.    LinkTopic       =   "Form1"
  21.    LockControls    =   -1  'True
  22.    MaxButton       =   0   'False
  23.    MinButton       =   0   'False
  24.    ScaleHeight     =   3297.239
  25.    ScaleMode       =   0  'User
  26.    ScaleWidth      =   6054.501
  27.    ShowInTaskbar   =   0   'False
  28.    StartUpPosition =   1  'CenterOwner
  29.    Begin VB.OptionButton optVariable 
  30.       Caption         =   "VariableField"
  31.       Height          =   255
  32.       Left            =   240
  33.       MaskColor       =   &H00000000&
  34.       TabIndex        =   4
  35.       Top             =   2160
  36.       Value           =   -1  'True
  37.       Width           =   2379
  38.    End
  39.    Begin VB.OptionButton optFixedField 
  40.       Caption         =   "FixedField"
  41.       Height          =   255
  42.       Left            =   240
  43.       MaskColor       =   &H00000000&
  44.       TabIndex        =   3
  45.       Top             =   1920
  46.       Width           =   2379
  47.    End
  48.    Begin VB.CheckBox chkAutoInc 
  49.       Caption         =   "AutoIncrField"
  50.       Height          =   255
  51.       Left            =   240
  52.       MaskColor       =   &H00000000&
  53.       TabIndex        =   5
  54.       TabStop         =   0   'False
  55.       Top             =   2640
  56.       Width           =   2379
  57.    End
  58.    Begin VB.CheckBox chkAllowZeroLen 
  59.       Caption         =   "AllowZeroLength"
  60.       Height          =   255
  61.       Left            =   240
  62.       MaskColor       =   &H00000000&
  63.       TabIndex        =   6
  64.       Top             =   3000
  65.       Width           =   2379
  66.    End
  67.    Begin VB.TextBox txtFieldName 
  68.       Height          =   285
  69.       Left            =   120
  70.       TabIndex        =   0
  71.       Top             =   360
  72.       Width           =   2895
  73.    End
  74.    Begin VB.ComboBox cboFieldType 
  75.       Height          =   315
  76.       ItemData        =   "ADDFIELD.frx":030A
  77.       Left            =   120
  78.       List            =   "ADDFIELD.frx":030C
  79.       Style           =   2  'Dropdown List
  80.       TabIndex        =   1
  81.       Top             =   960
  82.       Width           =   1695
  83.    End
  84.    Begin VB.TextBox txtFieldSize 
  85.       Height          =   285
  86.       Left            =   120
  87.       TabIndex        =   2
  88.       Top             =   1560
  89.       Width           =   1335
  90.    End
  91.    Begin VB.TextBox txtOrdinalPos 
  92.       Height          =   285
  93.       Left            =   3120
  94.       TabIndex        =   8
  95.       Top             =   360
  96.       Width           =   1335
  97.    End
  98.    Begin VB.TextBox txtValidationText 
  99.       Height          =   285
  100.       Left            =   3120
  101.       TabIndex        =   9
  102.       Top             =   960
  103.       Width           =   2895
  104.    End
  105.    Begin VB.TextBox txtValidationRule 
  106.       Height          =   285
  107.       Left            =   3120
  108.       TabIndex        =   10
  109.       Top             =   1680
  110.       Width           =   2895
  111.    End
  112.    Begin VB.TextBox txtDefaultValue 
  113.       Height          =   285
  114.       Left            =   3120
  115.       TabIndex        =   11
  116.       Top             =   2280
  117.       Width           =   2895
  118.    End
  119.    Begin VB.CheckBox chkRequired 
  120.       Caption         =   "Required"
  121.       Height          =   255
  122.       Left            =   240
  123.       MaskColor       =   &H00000000&
  124.       TabIndex        =   7
  125.       Top             =   3360
  126.       Width           =   2379
  127.    End
  128.    Begin VB.CommandButton cmdOK 
  129.       Caption         =   "&OK"
  130.       Default         =   -1  'True
  131.       Enabled         =   0   'False
  132.       Height          =   375
  133.       Left            =   3480
  134.       MaskColor       =   &H00000000&
  135.       TabIndex        =   12
  136.       Top             =   2760
  137.       Width           =   2175
  138.    End
  139.    Begin VB.CommandButton cmdClose 
  140.       Cancel          =   -1  'True
  141.       Caption         =   "&Close"
  142.       Height          =   375
  143.       Left            =   3480
  144.       MaskColor       =   &H00000000&
  145.       TabIndex        =   13
  146.       Top             =   3240
  147.       Width           =   2175
  148.    End
  149.    Begin VB.Label lblLabels 
  150.       AutoSize        =   -1  'True
  151.       Caption         =   " Name: "
  152.       Height          =   195
  153.       Index           =   0
  154.       Left            =   120
  155.       TabIndex        =   20
  156.       Top             =   120
  157.       Width           =   555
  158.    End
  159.    Begin VB.Label lblLabels 
  160.       AutoSize        =   -1  'True
  161.       Caption         =   " Type: "
  162.       Height          =   195
  163.       Index           =   2
  164.       Left            =   120
  165.       TabIndex        =   19
  166.       Top             =   720
  167.       Width           =   510
  168.    End
  169.    Begin VB.Label lblLabels 
  170.       AutoSize        =   -1  'True
  171.       Caption         =   " Size: "
  172.       Height          =   195
  173.       Index           =   3
  174.       Left            =   120
  175.       TabIndex        =   18
  176.       Top             =   1320
  177.       Width           =   435
  178.    End
  179.    Begin VB.Label lblLabels 
  180.       AutoSize        =   -1  'True
  181.       Caption         =   "OrdinalPosition: "
  182.       Height          =   195
  183.       Index           =   4
  184.       Left            =   3120
  185.       TabIndex        =   17
  186.       Top             =   120
  187.       Width           =   1170
  188.    End
  189.    Begin VB.Label lblLabels 
  190.       AutoSize        =   -1  'True
  191.       Caption         =   "ValidationText: "
  192.       Height          =   195
  193.       Index           =   5
  194.       Left            =   3120
  195.       TabIndex        =   16
  196.       Top             =   720
  197.       Width           =   1125
  198.    End
  199.    Begin VB.Label lblLabels 
  200.       AutoSize        =   -1  'True
  201.       Caption         =   "ValidationRule: "
  202.       Height          =   195
  203.       Index           =   6
  204.       Left            =   3120
  205.       TabIndex        =   15
  206.       Top             =   1320
  207.       Width           =   1110
  208.    End
  209.    Begin VB.Label lblLabels 
  210.       AutoSize        =   -1  'True
  211.       Caption         =   "DefaultValue: "
  212.       Height          =   195
  213.       Index           =   7
  214.       Left            =   3120
  215.       TabIndex        =   14
  216.       Top             =   2040
  217.       Width           =   1020
  218.    End
  219. Attribute VB_Name = "frmAddField"
  220. Attribute VB_GlobalNameSpace = False
  221. Attribute VB_Creatable = False
  222. Attribute VB_PredeclaredId = True
  223. Attribute VB_Exposed = False
  224. Option Explicit
  225. '>>>>>>>>>>>>>>>>>>>>>>>>
  226. Const FORMCAPTION = "Add Field"
  227. Const BUTTON1 = "&OK"
  228. Const BUTTON2 = "&Close"
  229. Const MSG1 = " Already exists!"
  230. '>>>>>>>>>>>>>>>>>>>>>>>>
  231. Private Sub cmdClose_Click()
  232.   Unload Me
  233. End Sub
  234. Sub Form_Load()
  235.   Me.Caption = FORMCAPTION
  236.   cmdOK.Caption = BUTTON1
  237.   cmdClose.Caption = BUTTON2
  238.   cboFieldType.AddItem "Boolean"
  239.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbBoolean
  240.   cboFieldType.AddItem "Byte"
  241.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbByte
  242.   cboFieldType.AddItem "Integer"
  243.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbInteger
  244.   cboFieldType.AddItem "Long"
  245.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbLong
  246.   cboFieldType.AddItem "Currency"
  247.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbCurrency
  248.   cboFieldType.AddItem "Single"
  249.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbSingle
  250.   cboFieldType.AddItem "Double"
  251.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbDouble
  252.   cboFieldType.AddItem "Date/Time"
  253.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbDate
  254.   cboFieldType.AddItem "Text"
  255.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbText
  256.   cboFieldType.AddItem "Binary"
  257.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbLongBinary
  258.   cboFieldType.AddItem "Memo"
  259.   cboFieldType.ItemData(cboFieldType.NewIndex) = dbMemo
  260.   SetDefaults
  261.   'need to disable controls that don't apply
  262.   'to non Microsoft Access tables
  263.   If gsDataType <> gsMSACCESS Then
  264.     optFixedField.Enabled = False
  265.     chkAutoInc.Enabled = False
  266.     optVariable.Enabled = False
  267.     txtValidationText.Enabled = False
  268.     txtValidationRule.Enabled = False
  269.     txtDefaultValue.Enabled = False
  270.     chkRequired.Enabled = False
  271.     chkAllowZeroLen.Enabled = False
  272.   End If
  273. End Sub
  274. Private Sub txtFieldName_Change()
  275.   'activate the ok button only if the
  276.   'name field has something in it
  277.   cmdOK.Enabled = (Len(txtFieldName.TEXT) > 0)
  278. End Sub
  279. Private Sub cboFieldType_Click()
  280.   Dim nFldType As Integer
  281.   'call function to set size and type of field
  282.   txtFieldSize.TEXT = SetFldProperties(cboFieldType.ItemData(cboFieldType.ListIndex))
  283.   txtFieldSize.Enabled = False
  284.   nFldType = cboFieldType.ItemData(cboFieldType.ListIndex)
  285.   'enable appropriate controls for each field type
  286.   If gsDataType <> gsMSACCESS Then
  287.     If nFldType = dbText Then
  288.       'allow entry of field length
  289.       txtFieldSize.Enabled = True
  290.       'default field size from Access UI
  291.       txtFieldSize.TEXT = "50"
  292.     End If
  293.     'only do the stuff below for MDB dbs
  294.     Exit Sub
  295.   End If
  296.   If nFldType = dbText Then
  297.     'allow entry of field length
  298.     txtFieldSize.Enabled = True
  299.     'default field size from Access UI
  300.     txtFieldSize.TEXT = "50"
  301.     'avaiable for memo and text
  302.     chkAllowZeroLen.Enabled = True
  303.     'avaiable for text only
  304.     optVariable.Enabled = True
  305.     optFixedField.Enabled = True
  306.     'disable these controls
  307.     chkAutoInc.Enabled = False
  308.     chkAutoInc.VALUE = vbUnchecked
  309.   ElseIf nFldType = dbMemo Then
  310.     'avaiable for memo and text
  311.     chkAllowZeroLen.Enabled = True
  312.     'disable these controls
  313.     optVariable.Enabled = False
  314.     optFixedField.Enabled = False
  315.     chkAutoInc.Enabled = False
  316.     'set the value to 0
  317.     optVariable.VALUE = False
  318.     optFixedField.VALUE = False
  319.     chkAutoInc.VALUE = vbUnchecked
  320.   ElseIf nFldType = dbLong Then
  321.     'enable this one for counter type fields
  322.     chkAutoInc.Enabled = True
  323.     'disable these controls
  324.     chkAllowZeroLen.Enabled = False
  325.     optVariable.Enabled = False
  326.     optFixedField.Enabled = False
  327.     'set the value to 0
  328.     chkAllowZeroLen.VALUE = vbUnchecked
  329.     optVariable.VALUE = False
  330.     optFixedField.VALUE = False
  331.   Else
  332.     'disable these for all other types
  333.     chkAllowZeroLen.Enabled = False
  334.     optVariable.Enabled = False
  335.     optFixedField.Enabled = False
  336.     chkAutoInc.Enabled = False
  337.     'set the value to 0
  338.     chkAllowZeroLen.VALUE = vbUnchecked
  339.     optVariable.VALUE = False
  340.     optFixedField.VALUE = False
  341.     chkAutoInc.VALUE = vbUnchecked
  342.   End If
  343. End Sub
  344. Private Sub cmdOK_Click()
  345.   On Error GoTo OkayErr
  346.   Dim fld As Field     'local field structure
  347.   Dim i As Integer
  348.   'get a fresh field object
  349.   Set fld = gtdfTableDef.CreateField()
  350.   'fill the field structure
  351.   With fld
  352.     .Name = txtFieldName.TEXT
  353.     .Type = cboFieldType.ItemData(cboFieldType.ListIndex)
  354.     .Size = txtFieldSize.TEXT
  355.     If Len(txtOrdinalPos.TEXT) > 0 Then .OrdinalPosition = txtOrdinalPos.TEXT
  356.     If gsDataType = gsMSACCESS Then
  357.       .Required = IIf(chkRequired.VALUE = vbChecked, -1, 0)
  358.       If .Type = dbText Then
  359.         'this only applies to text
  360.         .AllowZeroLength = IIf(chkAllowZeroLen.VALUE = vbChecked, -1, 0)
  361.       End If
  362.       If optFixedField.VALUE Then
  363.         .Attributes = .Attributes Or dbFixedField
  364.       End If
  365.       If .Type = dbLong Then
  366.         'only applies to long type
  367.         If chkAutoInc.VALUE = vbChecked Then
  368.           .Attributes = .Attributes Or dbAutoIncrField
  369.         End If
  370.       End If
  371.       If optVariable.VALUE Then
  372.         .Attributes = .Attributes Or dbVariableField
  373.       End If
  374.       .ValidationText = txtValidationText.TEXT
  375.       .ValidationRule = txtValidationRule.TEXT
  376.       .DefaultValue = txtDefaultValue.TEXT
  377.     End If
  378.   End With
  379.   'check for a dupe
  380.   If ObjectExists(gtdfTableDef.Fields, fld.Name) Then
  381.     MsgBox "'" & fld.Name & "'" & MSG1
  382.     txtFieldName.SelStart = 0
  383.     txtFieldName.SelLength = Len(txtFieldName.TEXT)
  384.     txtFieldName.SetFocus
  385.     Exit Sub
  386.   End If
  387.   'try to append the field
  388.   gtdfTableDef.Fields.Append fld
  389.   'must've been successful, so...
  390.   'add the item to the list
  391.   frmTblStruct.lstFields.AddItem txtFieldName
  392.   'make the new item active
  393.   frmTblStruct.lstFields.ListIndex = frmTblStruct.lstFields.NewIndex
  394.   'enable the add table button if needed
  395.   If frmTblStruct.cmdAddTable.Visible Then
  396.     frmTblStruct.cmdAddTable.Enabled = True
  397.   End If
  398.   'clear the name and allow entry of another
  399.   SetDefaults
  400.   txtFieldName.SetFocus
  401.   Exit Sub
  402. OkayErr:
  403.   ShowError
  404. End Sub
  405. Private Sub SetDefaults()
  406.   txtFieldName.TEXT = vbNullString
  407.   If gsDataType = gsMSACCESS Then
  408.     optFixedField.VALUE = False
  409.     chkAutoInc.VALUE = vbUnchecked
  410.     optVariable.VALUE = True
  411.     chkRequired.VALUE = vbUnchecked
  412.     chkAllowZeroLen.VALUE = vbChecked
  413.   Else
  414.     optFixedField.VALUE = False
  415.     chkAutoInc.VALUE = 2
  416.     optVariable.VALUE = False
  417.     chkRequired.VALUE = 2
  418.     chkAllowZeroLen.VALUE = 2
  419.   End If
  420.   cboFieldType.ListIndex = 8             'default to text
  421.   txtFieldSize.TEXT = 50                 'default to 50
  422.   txtValidationText.TEXT = vbNullString
  423.   txtValidationRule.TEXT = vbNullString
  424.   txtDefaultValue.TEXT = vbNullString
  425. End Sub
  426.